home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 033a / autoare2.zip / AUTOAREA.BAS next >
BASIC Source File  |  1991-04-26  |  4KB  |  45 lines
  1. 5 KEY OFF:DIM A$(255)
  2. 10 OPEN"r",1,"response":IF LOF(1)<>0 THEN CLOSE:GOTO 1000 ELSE CLOSE:KILL"response"
  3. 20 CLS:PRINT TAB(28);"A U T O    A R E A 1.01":PRINT:PRINT TAB(20);"Automatic Message Area Creation Utility":PRINT:PRINT TAB(32);"for OPUS 1.1#"
  4. 30 PRINT:PRINT:PRINT TAB(39);"by":PRINT:PRINT TAB(35);"Doug Rogers"
  5. 40 OPEN"r",1,"autoarea.cfg":IF LOF(1)=0 THEN CLOSE:KILL"autoarea.cfg":GOTO 100 ELSE CLOSE:OPEN"i",1,"autoarea.cfg"
  6. 45 FOR X=1 TO 3000:NEXT
  7. 50 INPUT #1,HIGHAREA:INPUT #1,DRIVESPEC$
  8. 60 IF NOT EOF(1) THEN DR=DR+1:INPUT #1,A$(DR):GOTO 60 ELSE CLOSE
  9. 100 CLS:PRINT"The beginning of the user-defined message segment is area:";HIGHAREA:PRINT"The Drivespec for the directory off which the message areas are to be located is";DRIVESPEC$
  10. 101 IF DRIVESPEC$="" THEN PRINT"UNDEFINED"
  11. 110 PRINT:PRINT"Change:":PRINT" <N>ext area":PRINT" <D>rivespec":PRINT" <Q>uit":INPUT AN$
  12. 120 IF AN$="D" OR AN$="d" THEN 300 ELSE IF AN$="N" OR AN$="n" THEN 200 ELSE 400
  13. 200 INPUT"At what area should the user defined areas begin";HIGHAREA:IF HIGHAREA<1 OR HIGHAREA>254 THEN PRINT"OUT OF RANGE (1-254):goto 200
  14. 210 GOTO 100
  15. 300 LINE INPUT"Enter the drivespec (ie C:\opus\) of the ROOT directory off which the message area directories are located.  This MUST be ended by a backslash (\):";DRIVESPEC$
  16. 310 IF DRIVESPEC$="" THEN DRIVESPEC$="C:\opus\"
  17. 320 IF RIGHT$(DRIVESPEC$,1)<>"\" THEN DRIVESPEC$=DRIVESPEC$+"\"
  18. 330 GOTO 100
  19. 400 IF DR>0 THEN 490 ELSE A$="dir "+DRIVESPEC$+">autoarea.tmp":SHELL A$
  20. 410 OPEN"i",1,"autoarea.tmp"
  21. 420 IF NOT EOF(1) THEN DR=DR+1:INPUT #1,A$:A$(DR)=LEFT$(A$,8):GOTO 420 ELSE CLOSE
  22. 430 KILL"autoarea.tmp":DR=DR-1
  23. 490 OPEN"o",1,"autoarea.cfg":PRINT #1,HIGHAREA:WRITE #1,DRIVESPEC$:FOR X=1 TO DR:PRINT #1,A$(X):NEXT:CLOSE:SYSTEM
  24. 1000 OPEN"i",1,"autoarea.cfg":INPUT #1,HIGHAREA:INPUT #1,DRIVESPEC$
  25. 1001 IF NOT EOF(1) THEN DR=DR+1:INPUT #1,A$(DR):GOTO 1001 ELSE CLOSE
  26. 1010 OPEN"i",1,"response":INPUT #1,USER$:INPUT #1,DUMMY$:INPUT #1,AREA$:INPUT #1,DIR$:CLOSE:KILL"response"
  27. 1020 Z=INSTR(USER$,CHR$(9)):USER$=LEFT$(USER$,Z):USER$=RIGHT$(USER$,LEN(USER$)-2):IF AREA$="" THEN 1200 ELSE AREA$=RIGHT$(AREA$,LEN(AREA$)-2):IF DIR$="" THEN 1300 ELSE DIR$=RIGHT$(DIR$,LEN(DIR$)-2)
  28. 1021 FOR X=1 TO LEN(DIR$):A=ASC(MID$(DIR$,X,1)):IF A>90 THEN A=A-32:MID$(DIR$,X,1)=CHR$(A)
  29. 1022 NEXT
  30. 1025 FOR X=1 TO DR:Z=INSTR(A$(X),DIR$):IF Z<>0 THEN ZX=1
  31. 1026 NEXT:IF ZX=1 THEN 2000
  32. 1030 FOR Z=HIGHAREA TO 254
  33. 1040 A$=HEX$(Z):IF Z<10 THEN A$="0"+A$
  34. 1050 SEARCH$="SYSTEM"+A$+".DAT":OPEN"r",1,SEARCH$:IF LOF(1)=0 THEN Y=Z:Z=255
  35. 1060 CLOSE:NEXT:A$="COPY AUTOAREA.DAT "+SEARCH$:SHELL A$:A$="MD "+DRIVESPEC$+DIR$:SHELL A$
  36. 1070 OPEN"r",1,SEARCH$:GET 1,3:FIELD 1,80 AS A$,40 AS B$:LSET B$=AREA$:PUT 1,3:GET 1,4:C$=DRIVESPEC$+DIR$+"\":FIELD 1,2 AS A$,LEN(C$) AS B$:LSET B$=C$:PUT 1,4:CLOSE
  37. 1080 C$=C$+"areainfo.bbs":OPEN"o",1,C$:PRINT #1,CHR$(22);CHR$(1);CHR$(16);CHR$(142):PRINT #1,AREA$:PRINT #1,"---hosted by ";USER$:CLOSE
  38. 1081 OPEN"o",1,"autoarea.cfg":PRINT #1,HIGHAREA:PRINT #1,DRIVESPEC$:FOR X=1 TO DR:PRINT #1,A$(X):NEXT:PRINT #1,DIR$:CLOSE
  39. 1090 OPEN"o",1,"response.bbs"
  40. 1091 PRINT #1,CHR$(22);CHR$(1);CHR$(16);CHR$(142):PRINT #1,"Your new area... ";AREA$;"... has been created.":PRINT #1,"It is area";Y:PRINT #1," ":PRINT#1,"Be aware that the sysop reserves the right to review the area, and to decide"
  41. 1100 PRINT#1,"if it should be kept, deleted, or distributed over the network.":PRINT#1," ":PRINT#1,"Thanks for using AUTOAREA by Doug Rogers, 108/110":CLOSE:SYSTEM
  42. 1200 OPEN"o",1,"response.bbs":PRINT #1,"Area not created... The area name entered is invalid...":CLOSE:SYSTEM
  43. 1300 OPEN"o",1,"response.bbs":PRINT#1,"Area not created... The short name asked for is invalid...":CLOSE:SYSTEM
  44. 2000 OPEN"o",1,"response.bbs":PRINT #1,"Area not created... The short name for the area is already in use.":CLOSE:SYSTEM
  45.